home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / octa205p.zip / octave-2.05 / updt-octave.cmd < prev   
OS/2 REXX Batch file  |  1997-03-16  |  27KB  |  732 lines
  1. /*
  2. *******************************************************************************
  3. ** Update an previous Octave/2 Installation                                  **
  4. ** (c) Klaus Gebhardt, 1996 - 1997                                           **
  5. *******************************************************************************
  6. */
  7.  
  8. /*
  9. *******************************************************************************
  10. ** This script will make all the necessary changes in the following files:   **
  11. **                                                                           **
  12. **   1. CONFIG.SYS                                                           **
  13. **   2. .emacs                                                               **
  14. **   3. .octaverc                                                            **
  15. **     (or the file pointed to by the environment variable OCTAVE_INITFILE)  **
  16. **   4. %INFOPATH%dir                                                        **
  17. **   5. make-octfile.cmd                                                     **
  18. *******************************************************************************
  19. ** It will also copy the info files to the directoy pointed to by the        **
  20. ** variable INFOPATH, and it replaces emx.dll, emxlibcs.dll and              **
  21. ** termcap.dat, if the files coming with Octave/2 are newer than those       **
  22. ** on your system.                                                           **
  23. *******************************************************************************
  24. ** This script also creates a folder with a program object for Octave/2      **
  25. ** on the WPS.                                                               **
  26. *******************************************************************************
  27. ** ALL ORIGINAL FILES, WHICH ARE MODIFIED OR REPLACED BY THIS SCRIPT         **
  28. ** ARE BACKUPED IN THE DIRECTORY YOU HAVE OCTAVE/2 INSTALLED IN.             **
  29. *******************************************************************************
  30. ** NO WARRANTY!                                                              **
  31. *******************************************************************************
  32. */
  33.  
  34. "@echo off"
  35. debug = ">NUL 2>NUL"
  36. debug_mode = 0;
  37.  
  38. version     = "2.05";
  39. script_arc  = "SCRIPTS.ZIP";
  40. dlfcn_arc   = "DLFCN.ZIP";
  41.  
  42. default_dir.0 = 2;
  43. default_dir.1 = "h:/apps/science/octave-";
  44. default_dir.2 = "i:/apps/octave-";
  45.  
  46. config_modified   = 0;
  47. config.0.nr =  9;
  48. config.1.nr =  8; config.1.name = "LIBPATH=";             config.1.zeile = "";
  49. config.2.nr =  9; config.2.name = "SET PATH=";            config.2.zeile = "";
  50. config.3.nr = 16; config.3.name = "SET OCTAVE_HOME=";     config.3.zeile = "";
  51. config.4.nr = 12; config.4.name = "SET TERMCAP=";         config.4.zeile = "";
  52. config.5.nr =  9; config.5.name = "SET TERM=";            config.5.zeile = "";
  53. config.6.nr =  9; config.6.name = "SET HOME=";            config.6.zeile = "";
  54. config.7.nr = 20; config.7.name = "SET OCTAVE_INITFILE="; config.7.zeile = "";
  55. config.8.nr = 13; config.8.name = "SET INFOPATH=";        config.8.zeile = "";
  56. config.9.nr = 12; config.9.name = "SET GNUPLOT=";         config.9.zeile = "";
  57.  
  58. emacs_modified = 0;
  59. octaverc_modified = 0;
  60. dir_modified = 0;
  61.  
  62.  
  63. call RxFuncAdd "SysLoadFuncs", "RexxUtil", "SysLoadFuncs"
  64. call SysLoadFuncs
  65.  
  66. parse upper arg option cmdl
  67.  
  68. /*
  69. *******************************************************************************
  70. ** Debug-Mode                                                                **
  71. *******************************************************************************
  72. */
  73. if (option == "/DEBUG") then
  74.   do
  75.     say "info: Running in DEBUG mode!";
  76.     "@echo on"
  77.     debug = ""
  78.     debug_mode = 1;
  79.   end
  80. else
  81.   do
  82.     debug_mode = 0;
  83.     cmdl = option;
  84.   end
  85.  
  86. /*
  87. *******************************************************************************
  88. ** Wrong argument and usage message                                          **
  89. *******************************************************************************
  90. */
  91. if ((cmdl <> "/USAGE") & (cmdl <> "")) then
  92.   do
  93.     say "error: Unknown command line option!";
  94.     say "";
  95.     cmdl = "/USAGE";
  96.   end
  97.  
  98. if (cmdl == "/USAGE") then
  99.   do
  100.     say "Usage:"
  101.     say "  Type 'updt-octave' to update your Octave/2" version "Installation";
  102.     say "  Type 'updt-octave /usage'   to see this message.";
  103.     say "on FAT systems you must type 'updt-oct' instead of 'updt-octave'";
  104.     exit;
  105.   end
  106.  
  107. /*
  108. *******************************************************************************
  109. ** Updating the installation                                 **
  110. *******************************************************************************
  111. */
  112. say "info: Updating Octave/2" version "..."
  113.  
  114. octave_home = to_unix_sep(directory());
  115. octave_dll = octave_home || "/dll";
  116. if (check_octave_files(octave_home, 1) == 0) then
  117.   do
  118.     say "error: Run this script from within in the directory octave is"
  119.     say "error: installed in!"
  120.     exit;
  121.   end
  122. say "info: Octave/2 is installed in" octave_home || ".";
  123.  
  124. /* Removing old files */
  125. "del doc\refcard*" debug
  126.  
  127. /* Unzip the files for dynamic loading */
  128. call unzip_dlfcn_files dlfcn_arc
  129.  
  130. /* Create the script for compiler DLFCN modules */
  131. call make_octfile octave_home
  132.  
  133. /* Unzip the script files */
  134. call unzip_script_files script_arc
  135.  
  136. say "info: Done.";
  137. exit;
  138.  
  139. /*
  140. *******************************************************************************
  141. ** Write the modified config.sys                                             **
  142. *******************************************************************************
  143. */
  144. write_config_new: procedure expose config. debug version
  145. parse arg boot, dir
  146.   config_old = to_os2_sep(dir) || "\config.old";
  147.   config_new = to_os2_sep(dir) || "\config.new";
  148.   "del" config_new debug
  149.  
  150.   rc = stream(config_old, "C", "open read");
  151.   if rc <> "READY:" then
  152.     do
  153.       say "error: Cannot open the backup of CONFIG.SYS!";
  154.       exit;
  155.     end
  156.  
  157.   rc = stream(config_new, "C", "open write");
  158.   if rc <> "READY:" then
  159.     do
  160.       say "error: Cannot open CONFIG.NEW!";
  161.       rc = stream(config_old, "C", "close");
  162.       exit;
  163.     end
  164.  
  165.   say "info: Writing" config_new "...";
  166.   do while(lines(config_old))
  167.     line = linein(config_old);
  168.     do i=1 to config.0.nr
  169.       if (to_upper(substr(strip(line), 1, config.i.nr)) == config.i.name) then
  170.         do
  171.           if config.i.zeile <> "" then
  172.             do
  173.               p = pos(to_upper(config.i.name), to_upper(config.i.name));
  174.               if (p <= 1) then
  175.                 line = config.i.name || config.i.zeile;
  176.               else
  177.                 line = substr(" ",1,p," ") || config.i.name || config.i.zeile;
  178.               config.i.zeile = "";
  179.             end
  180.           leave;
  181.         end
  182.     end
  183.     call lineout config_new, line
  184.   end
  185.  
  186.   sep = 0;
  187.   do i=1 to config.0.nr
  188.     if (config.i.zeile <> "") then
  189.       do
  190.         if (sep == 0) then
  191.           do
  192.             call lineout config_new, ""
  193.             call lineout config_new, "REM Octave/2" version
  194.             sep = 1;
  195.           end
  196.         call lineout config_new, config.i.name || config.i.zeile;
  197.         config.i.zeile = "";
  198.       end
  199.   end
  200.  
  201.   rc = stream(config_new, "C", "close");
  202.   rc = stream(config_old, "C", "close");
  203.   return;
  204.  
  205. /*
  206. *******************************************************************************
  207. ** Analysing CONFIG.SYS:                                                     **
  208. *******************************************************************************
  209. */
  210. read_config_sys: procedure expose config. default_dir. debug
  211. parse arg boot, dir
  212.   config_old = to_os2_sep(dir) || "\config.old";
  213.   say "info: Copying" boot || "\config.sys to" config_old "...";
  214.   "copy" boot || "\config.sys" config_old debug
  215.  
  216.   rc = stream(config_old, "C", "open read");
  217.   if (rc <> "READY:") then
  218.     do
  219.       say "error: Cannot open the backup of CONFIG.SYS!";
  220.       exit;
  221.     end
  222.  
  223.   say "info: Analysing" config_old "...";
  224.   do while(lines(config_old))
  225.     line  = strip(linein(config_old));
  226.     do i=1 to config.0.nr
  227.       strupper = to_upper(substr(line, 1, config.i.nr));
  228.       if (strupper == config.i.name) then
  229.         do
  230.           config.i.zeile = substr(line, config.i.nr+1);
  231.           leave;
  232.         end
  233.     end
  234.   end
  235.   rc = stream(config_old, "C", "close");
  236.  
  237.   if (config.1.zeile == "") then
  238.     do
  239.       say "error: No "LIBPATH" statement found!";
  240.       exit;
  241.     end
  242.   else libpath = config.1.zeile;
  243.  
  244.   if (config.2.zeile == "") then
  245.     do
  246.       say "error: No "SET PATH" statement found!";
  247.       exit;
  248.     end
  249.   else path = config.2.zeile;
  250.  
  251.   oh = config.3.zeile;
  252.   if (oh <> "") then return to_unix_sep(oh);
  253.   else
  254.     do
  255.       do i = 1 to default_dir.0
  256.         oh = check_octave_old_home(default_dir.i, libpath, path);
  257.         if (oh <> "") then return to_unix_sep(oh);
  258.       end
  259.     end
  260.   return "";
  261.  
  262. check_octave_old_home: procedure expose debug
  263. parse arg str, libpath, path
  264.   string = to_os2_sep(str);
  265.   pa = 0;
  266.   do while(1)
  267.     pa = pos(to_upper(string), to_upper(path), pa + 1);
  268.     if (pa == 0) then return "";
  269.     if ((pa <> 1) & (substr(path, pa - 1, 1) <> ";")) then iterate;
  270.     pe = pos(";", path, pa);
  271.     if (pe == 0) then old_home = substr(path, pa);
  272.     else              old_home = substr(path, pa, pe-pa);
  273.     qa = pos(to_upper(old_home || "\DLL"), to_upper(libpath));
  274.     if (qa == 0) then iterate;
  275.     if ((qa <> 1) & (substr(path, qa - 1, 1) <> ";")) then iterate;
  276.     qe = pos(";", libpath, qa);
  277.     if qe == 0 then old_dll = to_upper(substr(libpath, qa));
  278.     else            old_dll = to_upper(substr(libpath, qa, qe-qa));
  279.     if (to_upper(old_home || "\DLL") == old_dll) then
  280.       do
  281.     flag = check_octave_files(old_home, 0);
  282.     if (flag == 0) then
  283.           do
  284.             say "notice: I FOUND AN OLD OCTAVE DIRECTORY ("fullpath") IN";
  285.             say "notice: LIBPATH AND PATH, BUT WITHOUT ANY OCTAVE FILES.";
  286.             say "notice: SHOULD I REMOVE ALL ENTRIES IN LIBPATH AND PATH";
  287.             say "notice: POINTING TO THAT DIRECTORY [Y/N]";
  288.             parse pull in;
  289.             flag = (in == "Y") | (in == "y");
  290.           end
  291.         if (flag) then return to_unix_sep(old_home);
  292.       end
  293.     else  return "";
  294.   end
  295.  
  296. check_octave_files: procedure expose debug
  297. parse arg string, flag
  298.   path = to_os2_sep(string);
  299.   rc = SysFileTree(path || "\octave.exe",     exe, "FO");
  300.   rc = SysFileTree(path || "\octave.ico",     ico, "FO");
  301.   rc = SysFileTree(path || "\dll\cruft?.dll", crt, "FO");
  302.   if (flag <> 0) then rc = SysFileTree(path || "\dll\octave?.dll", oct, "FO");
  303.   else                oct.0 = 2;
  304.   res = (exe.0 == 1) & (ico.0 == 1) & (crt.0 == 4) & (oct.0 == 2);
  305.   return res;
  306.  
  307. /*
  308. *******************************************************************************
  309. ** Updating the emx TERMCAP.DAT                                              **
  310. *******************************************************************************
  311. */
  312. emx_termcap: procedure expose debug
  313. parse arg termcap
  314.   call SysFileTree "etc\termcap.dat", oct_datei, "FT";
  315.   if oct_datei.0 <> 1 then return termcap;
  316.   if datei.1 > 80 then oct = "19" || oct_datei.1;
  317.   else                 oct = "20" || oct_datei.1;
  318.  
  319.   call SysFileTree to_os2_sep(termcap), emx_datei, "FT";
  320.   if emx_datei.0 <> 1 then return "";
  321.   if datei.1 > 80 then emx = "19" || emx_datei.1;
  322.   else                 emx = "20" || emx_datei.1;
  323.  
  324.   if oct == emx then return termcap;
  325.   if oct > emx then
  326.     do
  327.       say "info: Replacing" to_os2_sep(termcap) "...";
  328.       "copy" to_os2_sep(termcap) "termcap.old" debug
  329.       "copy etc\termcap.dat" to_os2_sep(termcap) debug
  330.     end
  331.   else
  332.     do
  333.       say "info: Removing termcap.dat coming with Octave/2 ...";
  334.       "del etc\termcap.dat" debug
  335.       "rd etc" debug
  336.     end
  337.  
  338.   return termcap;
  339.  
  340. /*
  341. *******************************************************************************
  342. ** Replacing the emx-DLLs                                                    **
  343. *******************************************************************************
  344. */
  345. emx_dlls: procedure expose debug
  346. parse arg libpath, file
  347.   call SysFileTree "dll\" || file, oct_datei, "FT";
  348.   if oct_datei.0 <> 1 then return;
  349.   if datei.1 > 80 then oct = "19" || oct_datei.1;
  350.   else                 oct = "20" || oct_datei.1;
  351.  
  352.   count = 0;
  353.   do while(1)
  354.     n = setlocal();
  355.     "SET OCTAVE_LIBPATH=" || libpath
  356.     fullpath = SysSearchPath(OCTAVE_LIBPATH, file);
  357.     if fullpath == "" then leave;
  358.     call SysFileTree fullpath, emx_datei, "FT";
  359.     if emx_datei.0 <> 1 then leave;
  360.     if datei.1 > 80 then emx = "19" || emx_datei.1;
  361.     else                 emx = "20" || emx_datei.1;
  362.     n = endlocal();
  363.  
  364.     if oct == emx then leave;
  365.     if oct > emx then
  366.       do
  367.         count = count+1;
  368.         bak_file = substr(file, 1, length(file)-3) || count;
  369.         "copy" fullpath bak_file debug
  370.         say "info: Older DLL (" || file || ") saved as:" bak_file;
  371.         say "info: Removing DLL (" || file || ") ...";
  372.         rc = 1;
  373.         do while(rc <> 0)
  374.           rc = SysFileDelete(fullpath);
  375.           if rc <> 0 then
  376.             do
  377.               say "notice: UNABLE TO DELETE FILE:" fullpath;
  378.               say "notice: THE DLL IS USED BY ONE OR MORE EMX PROGRAMS!";
  379.               say "notice: KILL ALL THOSE PROGRAMS BEFORE CONTINUING!";
  380.               say "notice: PRESS ENTER, WHEN READY ...";
  381.               parse pull in;
  382.             end
  383.         end            
  384.       end
  385.     else
  386.       do
  387.         say "info: Removing" file "coming with Octave/2 ...";
  388.         "del dll\" || file debug;
  389.         leave;
  390.       end
  391.   end
  392.   return;
  393.  
  394. /*
  395. *******************************************************************************
  396. ** Updating .octaverc                                                        **
  397. *******************************************************************************
  398. */
  399. update_octaverc: procedure expose debug debug_mode version
  400. parse arg home, initfile, old, new
  401.   if (initfile == "") then octrc = ".octaverc";
  402.   else                     octrc = initfile;
  403.  
  404.   octrc_new = "octaverc.new";
  405.   rc = ini_files(home, octrc, "octaverc", old, new);
  406.   if (rc == -1) then
  407.     do
  408.       "del" octrc_new debug
  409.       rc = stream(octrc_new, "C", "open write");
  410.       if (rc == "READY:") then
  411.         do
  412.           call lineout octrc_new, "# Startup file"
  413.           call lineout octrc_new, "# Octave" version "for OS/2"
  414.           call lineout octrc_new, "# (c) 1996 - 1997, Klaus Gebhardt"
  415.           rc = stream(octrc_new, "C", "close");
  416.           rc = 2;
  417.         end
  418.       else
  419.         do
  420.           say "error: Cannot create octaverc.new!";
  421.          exit;
  422.         end
  423.     end
  424.  
  425.   if (rc == 2) then
  426.     do
  427.       "del" to_os2_sep(home) || "\" || octrc debug
  428.       octrc_ini = to_os2_sep(home) || "\octave.ini"
  429.       "copy" octrc_new octrc_ini debug
  430.       "ren" octrc_ini ".octaverc" debug
  431.       rc = stream(octrc_ini, "C", "open read");
  432.       if (rc == "READY:") then
  433.         do
  434.           rc = stream(octrc_new, "C", "close");
  435.           rc = stream(octrc_ini, "C", "open write");
  436.           call lineout octrc_new, ''
  437.           call lineout octrc_new, 'history_file = "octave.hst"'
  438.           rc = stream(octrc_new, "C", "close");
  439.           return "octave.ini";
  440.         end
  441.       return "";
  442.     end
  443.   return initfile;
  444.  
  445. /*
  446. *******************************************************************************
  447. ** Modify the files .emacs, .octaverc                                        **
  448. *******************************************************************************
  449. */
  450. ini_files: procedure expose debug
  451. parse arg home, inifile, newfile, oldpath, newpath
  452.   file = to_os2_sep(home) || "\" || inifile;
  453.   ini_old = newfile || ".old";
  454.   ini_new = newfile || ".new";
  455.   say "info: Copying" file "to" ini_old "...";
  456.   "copy" file ini_old debug
  457.  
  458.   old = to_unix_sep(oldpath);
  459.   new = to_unix_sep(newpath);
  460.  
  461.   rc = stream(ini_old, "C", "open read");
  462.   if (rc <> "READY:") then return -1;
  463.  
  464.   "del" ini_new debug;
  465.   rc = stream(ini_new, "C", "open write");
  466.   if (rc <> "READY:") then
  467.     do
  468.       say "info: Cannot open" ini_new || "!";
  469.       rc = stream(ini_old, "C", "close");
  470.       exit;
  471.     end
  472.  
  473.   if (to_upper(old) == to_upper(new)) then return 0;
  474.  
  475.   rv = 1;
  476.   do while(lines(ini_old))
  477.     line  = linein(ini_old);
  478.     p = pos(to_upper(old), to_upper(line));
  479.     if (p <> 0) then
  480.       do
  481.         rv = 2;
  482.         line = substr(line, 1, p-1) || new || substr(line, p+length(old));
  483.       end
  484.     call lineout ini_new, line
  485.   end
  486.  
  487.   rc = stream(ini_new, "C", "close");
  488.   rc = stream(ini_old, "C", "close");
  489.   return rv;
  490.  
  491. /*
  492. *******************************************************************************
  493. ** Remove old INFO files, modify all dir files                               **
  494. *******************************************************************************
  495. */
  496. info_path_dir: procedure expose debug
  497. parse arg info_path, octave_home, version
  498.   infopath = to_os2_sep(info_path);
  499.   octaveinfopath = to_os2_sep(octave_home || "/doc");
  500.  
  501.   p = 1;
  502.   q = 1;
  503.   do while (q > 0)
  504.     q = pos(";", infopath, p);
  505.     if (q == 0) then infodir = substr(infopath, p);
  506.     else             infodir = substr(infopath, p, q - p);
  507.     p = q + 1;
  508.  
  509.     if (infodir == ".")  then iterate;
  510.     if (to_upper(infodir) == to_upper(octaveinfopath)) then iterate;
  511.  
  512.     say "info: Removing old info files in" infodir;
  513.     "del" infodir || "\octave" debug
  514.     "del" infodir || "\octave.i0?" debug
  515.     "del" infodir || "\octave.i1?" debug
  516.     "del" infodir || "\liboct" debug
  517.     "del" infodir || "\liboct.i0?" debug
  518.     "del" infodir || "\faq" debug
  519.  
  520.     file = infodir || "\dir"
  521.     dir_old = "dir" || p || ".old";
  522.     dir_new = "dir" || p || ".new";
  523.     say "info: Copying" file "to" dir_old "...";
  524.     "copy" file dir_old debug
  525.  
  526.     rc = stream(dir_old, "C", "open read");
  527.     if (rc <> "READY:") then return;
  528.  
  529.     "del" dir_new debug;
  530.     rc = stream(dir_new, "C", "open write");
  531.     if (rc <> "READY:") then
  532.       do
  533.         say "error: Cannot open" dir_new || "!";
  534.         rc = stream(dir_old, "C", "close");
  535.         exit;
  536.       end
  537.  
  538.     line = " ";
  539.     do while(lines(dir_old))
  540.       if line == d2c(31) then call lineout dir_new, line
  541.       line  = linein(dir_old);
  542.       parse var line w1 w2 ":" w3 "." w4
  543.       if ((w1 <> "*") | ((to_upper(w3) <> "(FAQ)") & (to_upper(w3) <> "(OCTAVE)") & (to_upper(w3) <> "(LIBOCT)"))) then
  544.         do
  545.           if line <> d2c(31) then call lineout dir_new, line
  546.         end
  547.     end
  548.  
  549.     call lineout dir_new, "* octave:    (octave).      Octave" version || "."
  550.     call lineout dir_new, "* liboctave: (liboct).      Info about liboctave" version || "."
  551.     call lineout dir_new, "* octave-faq:(faq).         FAQs about Octave" version || "."
  552.    call lineout dir_new, d2c(31)
  553.  
  554.     rc = stream(dir_new, "C", "close");
  555.     rc = stream(dir_old, "C", "close");
  556.  
  557.     say "info: Copying" dir_new "to" file "...";
  558.     "copy" dir_new file debug
  559.   end
  560.   return;
  561.  
  562. /*
  563. *******************************************************************************
  564. ** Create MAKE-OCTFILE                                                       **
  565. *******************************************************************************
  566. */
  567. make_octfile: procedure expose debug
  568. parse arg octave_home
  569.   "del make-octfile.cmd make-oct.cmd" debug
  570.   rc = stream("make-oct.cmd", "C", "open write");
  571.   if (rc <> "READY:") then
  572.     do
  573.       say "error: Cannot open make-oct.cmd!"
  574.       exit;
  575.     end
  576.  
  577.   call lineout "make-oct.cmd", "/* Build .OCT file from source */"
  578.   call lineout "make-oct.cmd", "/* (c) Klaus Gebhardt, 1997 */"
  579.   call lineout "make-oct.cmd", "'@setlocal'"
  580.   call lineout "make-oct.cmd", "'@SET C_INCLUDE_PATH=" || to_unix_sep(octave_home) || "/dlfcn/octave;" || to_unix_sep(octave_home) || "/dlfcn;%C_INCLUDE_PATH%'"
  581.   call lineout "make-oct.cmd", "'@SET CPLUS_INCLUDE_PATH=" || to_unix_sep(octave_home) || "/dlfcn/octave;" || to_unix_sep(octave_home) || "/dlfcn;%CPLUS_INCLUDE_PATH%'"
  582.   call lineout "make-oct.cmd", "'@SET LIBRARY_PATH=" || to_unix_sep(octave_home) || "/dlfcn/lib;%LIBRARY_PATH%'"
  583.   call lineout "make-oct.cmd", "call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'"
  584.   call lineout "make-oct.cmd", "call SysLoadFuncs"
  585.   call lineout "make-oct.cmd", "parse arg ccfile libs"
  586.   call lineout "make-oct.cmd", "if (ccfile <> '') then"
  587.   call lineout "make-oct.cmd", "  do"
  588.   call lineout "make-oct.cmd", "    len  = length(ccfile);"
  589.   call lineout "make-oct.cmd", "    name = substr(ccfile,1,len-3);"
  590.   call lineout "make-oct.cmd", "    ext  = substr(ccfile,len-2);"
  591.   call lineout "make-oct.cmd", "  end"
  592.   call lineout "make-oct.cmd", "if ((ext <> '.cc') & (ext <> '.CC')) then"
  593.   call lineout "make-oct.cmd", "  do"
  594.   call lineout "make-oct.cmd", "    say 'error: invalid argument'"
  595.   call lineout "make-oct.cmd", "    exit;"
  596.   call lineout "make-oct.cmd", "  end"
  597.   call lineout "make-oct.cmd", "gccopt2 = '-m486 -mieee-fp -O3 -malign-loops=2 -malign-jumps=2 -malign-functions=2 -DEMX09C -DOS2';"
  598.   call lineout "make-oct.cmd", "'gcc' gccopt2 '-s -c' ccfile '-o' name || '.obj -Zomf'"
  599.    call lineout "make-oct.cmd", "'@echo LIBRARY' name || ' INITINSTANCE TERMINSTANCE>' name || '.def'"
  600.   call lineout "make-oct.cmd", "'@echo DESCRIPTION ' || d2c(34) || name || '.oct, (c) Klaus Gebhardt 1995-1997' || d2c(34) || '>>' name || '.def'"
  601.   call lineout "make-oct.cmd", "'@echo.>>' name || '.def'"
  602.   call lineout "make-oct.cmd", "'@echo DATA>>' name || '.def'"
  603.   call lineout "make-oct.cmd", "'@echo   MULTIPLE NONSHARED>>' name || '.def'"
  604.   call lineout "make-oct.cmd", "'@echo.>>' name || '.def'"
  605.   call lineout "make-oct.cmd", "'@echo EXPORTS>>' name || '.def'"
  606.   call lineout "make-oct.cmd", "'emxexp' name || '.obj >> ' name || '.def'"
  607.   call lineout "make-oct.cmd", "lnkopt2 = '-lcruft1 -lcruft2 -lcruft3 -lcruft4 -loctave1 -loctave2 -lreadline -lgnuinfo -lkpathsea -lxmalloc -lgpp2 -lstdcpp2 -lsocket -ldlfcn -lf2cdll -loct-img' libs;"
  608.   call lineout "make-oct.cmd", "'gcc' gccopt2 '-o' name || '.oct' name || '.def' name || '.obj' lnkopt2 '-Zdll -Zomf -Zcrtdll'"
  609.   call lineout "make-oct.cmd", "'@del' name || '.obj' name || '.def >NUL 2>NUL'"
  610.   call lineout "make-oct.cmd", "'@endlocal'"
  611.   call lineout "make-oct.cmd", "exit;"
  612.   rc = stream("make-oct.cmd", "C", "close");
  613.   "ren make-oct.cmd make-octfile.cmd" debug
  614.   return;
  615.  
  616. /*
  617. *******************************************************************************
  618. ** Unzip DLFCN files                                                         **
  619. *******************************************************************************
  620. */
  621. unzip_dlfcn_files: procedure expose debug
  622. parse arg dlfcn
  623.   ".\unzip -o" dlfcn debug
  624.   return;
  625.  
  626. /*
  627. *******************************************************************************
  628. ** Unzip script files                                                        **
  629. *******************************************************************************
  630. */
  631. unzip_script_files: procedure expose debug
  632. parse arg zipfile
  633.   rc = SysFileTree(zipfile, fs, "F");
  634.   if fs.0 = 0 then return;
  635.   rc = SysFileTree("ChangeLog", fs, "F");
  636.   if fs.0 = 1 then scr = "scripts/*";
  637.   else             scr = "scripts.fat/*";
  638.   say "info: Unzipping scriptfiles ...";
  639.   if fs.0 = 0 then "ren scripts scripts.fat";
  640.   ".\unzip -o" zipfile scr debug
  641.   if fs.0 = 0 then "ren scripts.fat scripts";
  642.   return;
  643.  
  644. /*
  645. *******************************************************************************
  646. ** Create a WPS object for Octave/2                                          **
  647. *******************************************************************************
  648. */
  649. create_wps_object: procedure expose debug
  650. parse arg octave_home, version
  651.   call SysCreateObject "WPFolder", "Octave/2", "<WP_DESKTOP>", ,
  652.        "OBJECTID=<HWB_OCTAVE_FOLDER>", "fail"
  653.  
  654.   object_name = "Octave" version;
  655.   octave_file = to_os2_sep(octave_home) || "\octave.exe";
  656.   octave_icon = to_os2_sep(octave_home) || "\octave.ico";
  657.  
  658.   rc = SysCreateObject("WPProgram", object_name, "<HWB_OCTAVE_FOLDER>", ,
  659.        "EXENAME="octave_file";PROGTYPE=WINDOWABLEVIO;ICONFILE="octave_icon||,
  660.        ";OBJECTID=<HWB_OCTAVE>", "replace");
  661.  
  662.   if rc == 1 then say "info: Program object for Octave created successfully."
  663.   else            say "notice: Could not create program object for Octave."
  664.   return;
  665.  
  666. /*
  667. *******************************************************************************
  668. ** Determine the drive OS/2 is booted from                                   **
  669. *******************************************************************************
  670. */
  671. get_boot_drive: procedure expose debug
  672.   irc = SysIni("BOTH", "FolderWorkareaRunningObjects",,
  673.                "ALL:", "Objects");
  674.   boot1 = left(Objects.1, 2);
  675.   boot2 = substr(translate(value("PATH", , "OS2ENVIRONMENT")), pos("\OS2\SYSTEM", translate(value("PATH", , "OS2ENVIRONMENT")))-2, 2);
  676.   rc = SysFileTree(boot1 || "\config.sys", cfg, "FO");
  677.   if ((to_upper(boot1) <> to_upper(boot2)) | (cfg.0 <> 1)) then
  678.     do
  679.       say "error: Unable to determine the boot drive!";
  680.       exit;
  681.     end
  682.   return boot1;
  683.  
  684. /*
  685. *******************************************************************************
  686. ** Replace old pathes                                                        **
  687. *******************************************************************************
  688. */
  689. subst_paths: procedure expose debug
  690. parse arg path_arg, old_path, new_path
  691.   path= to_os2_sep(path_arg);
  692.   old = to_os2_sep(old_path);
  693.   new = to_os2_sep(new_path);
  694.  
  695.   p = 0;
  696.   do while(1)
  697.     p = pos(to_upper(old), to_upper(path), p + 1);
  698.     if (p == 0) then
  699.       do
  700.         if (substr(path, length(path)) == ";") then return path || new || ";";
  701.         else                                        return path || ";" || new;
  702.       end
  703.     if ((p <> 1) & (substr(path, p - 1, 1) <> ";")) then iterate;
  704.     q = pos(";", path, p);
  705.     if (q == 0) then old_path = substr(path, p);
  706.     else             old_path = substr(path, p, q - p);
  707.     if (to_upper(old_path) <> to_upper(old)) then iterate;
  708.     if (q == 0) then return substr(path, 1, p-1) || new;
  709.     else             return substr(path, 1, p-1) || new || substr(path, q);
  710.   end
  711.  
  712. /*
  713. *******************************************************************************
  714. ** Utilities                                                                 **
  715. *******************************************************************************
  716. */
  717. to_upper: procedure
  718. parse arg string
  719.   return translate(string, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz");
  720.  
  721. to_lower: procedure
  722. parse arg string
  723.   return translate(string, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
  724.  
  725. to_unix_sep: procedure
  726. parse arg string
  727.   return translate(string, "/", "\");
  728.  
  729. to_os2_sep: procedure
  730. parse arg string
  731.   return translate(string, "\", "/");
  732.